perm filename PREFIL.F4[MSS,LCS] blob
sn#155881 filedate 1975-04-24 generic text, type T, neo UTF8
00010 C**** CHANGE 1, 2 AND 3 TO JFCL IN DDT WHEN USING DISTORTION.(SEE 'LINES')
00100 SUBROUTINE FILLMS(L,IDAT,R2,CENTR,R6,R7)
00110 COMMON/DPY/ST(4000),WDS(250),MEDIT,IGO/DL/RSIZ,SAVER,NAME
00120 COMMON/DST/BB,CC/FLM/X(600)
00130 COMMON/ALF/INP(65),DX,RX,D,R,C,KK,J,ML
00200 DIMENSION IDAT(1),NX(600)
00210 EQUIVALENCE (NX,X)
00220 COMMON/PLTR/IPLT,RHT,DIS/LL/LL/STF/RR(8),RSTJ2
00222 CC INTEGER XGP
00225 CC DATA XGP/2/,MD/6/
00226 DATA MD/6/ , RHT/1.0/
00227 C MD=DISPLAY CHANGE XGP TO 1 IN DDT WHEN PLOTTING ON XGP!
00230 DX=DIS
00240 RX=RHT
00270 D=RSTJ2*R6
00280 R=RSTJ2*R7
00400 1 GO TO 10
00450 C=CC
00460 B=BB
00500 C SAVES IT. IT WILL RETURN LATER.
00525 BB=B/DIS
00550 CC=1000
00600 10 KK=-2
00700 DO 205 J=1,L
00800 CALL UNPACK(M,N,IDAT(J))
00900 KK=KK+3
00950 KX=KK+2
01000 NX(KX)=2
01100 IF(LL.EQ.3)NX(KX)=3
01200 X(KK)=ROFF((R2+D*M)*DIS)
01300 X(KK+1)=ROFF((CENTR+R*N)*RHT)
01310 2 GO TO 205
01320 X(KK+1)=X(KK+1)*(C-BB*(ABS(X(KK))))
01330 C FOR DISTORTION
01340 205 CONTINUE
01400 NX(3)=KX
01410 DIS=1.0
01420 RHT=DIS
01500 M=MD
01600 CC IF(IPLT)M=MP-IXRX
01610 IF(IPLT.GE.0)GO TO 20
01615 CC M=RSIZ+.4
01617 M=1
01620 IF(RSIZ.GE.2.)M=2
01630 CC IF(M.GT.XGP)M=XGP
01650 C STOPS DISTORTION IN 'LINES'
01700 20 CALL FILLER(X,M)
01705 C ****** CALLS NEW FILL.FAI (CLEM'S)
01710 DIS=DX
01720 RHT=RX
01730 3 RETURN
01740 C NEXT TO RESET DISTORTION FACT.
01745 BB=B
01750 CC=C
01800 END
01900
02000 SUBROUTINE ROTATE(I,L)
02100 DIMENSION I(1)
02105 COMMON/LL/LL
02110 COMMON R2,JA,CENTR,JB,RJQ(20),JQ(20)/STF/RR(8),RSTJ2
02155 EQUIVALENCE (R6,RJQ(4)),(R7,RJQ(5)),(DEG,RJQ(7))
02190 R7=R7*RSTJ2
02195 R6=R6*RSTJ2
02200 N=I(L)
02225 KNT=601
02250 C ROTATED DATA IS PUT BACK STARTING AT LOCATION 601.
02275 I(KNT)=N
02300 DO 1 K=L+1,N+L-1
02400 CALL UNPACK(J,M,I(K))
02500 X=J*R6
02600 Y=M*R7
02700 JJ=I(K)/100000000
02800 AX=ATAN2(X,Y)*57.29578
02900 HYP=SQRT(X**2+Y**2)
03000 ROT=DEG+AX
03100 J=ROFF(HYP*COSD(ROT))
03200 M=ROFF(HYP*SIND(ROT))
03300 KNT=KNT+1
03400 IF(J)J=1000-J
03500 IF(M)M=1000-M
03600 1 I(KNT)=M*10000+J+JJ*100000000
03700 L=601
03800 R6=1.
03900 R7=1.
04000 RSTJ2=1.
04100 C SIZE CHANGES MUST BE MADE BEFORE ROTATION!!!!! ELSE IT DISTORTS.
04200 END